Windows 95 Super Collection/Windows 95 Super Collection.iso/win95/network/netuser/netuser.bas

BASIC Source File | 1995-06-16 | 5.9 KB | 202 lines

Option Explicit
'
'   This module will return the user name of the person who signed into
'   the system. This module should work with the following operating
'   systems: Windows 3.x, Windows for Workgroups, Windows 95 and
'   Windows NT.
'
'   This module is written for 16 bit applications, as 32 bit development
'   environments become available this module will need to change.
'
'   This module requires the CALL32.DLL file to function correctly
'   under Windows 95 and Windows NT. This DLL should be included with
'   your application and copied to the users SYSTEM directory under
'   windows.
''''
'
'   Declare variables needed
'
Dim mlngReturnStatus As Long
Dim mintInitialized As Integer
Dim mlngGetUserNameA As Long
'
'   Declare constants for windows version(s)
'
Const WV_WIN3X = 0
Const WV_WINWFW = 1
Const WV_WINNT = 2
Const WV_WIN95 = 3
'
'   Constants used by API(s)
'
Const WF_WINNT = &H4000

Const WNNC_NET_MultiNet = &H8000
Const WNNC_SUBNET_WinWorkgroups = 4
Const WNNC_NET_TYPE = 2

'/* General */

Const WN_SUCCESS = &H0
'
'   API Declaration
'
Declare Function KRN_GetVersion Lib "kernel" Alias "GetVersion" () As Long
Declare Function KRN_GetWinFlags Lib "Kernel" Alias "GetWinFlags" () As Long
Declare Function USR_WNetGetCaps Lib "User" Alias "WNetGetCaps" (ByVal nIndex As Integer) As Integer
Declare Function WFW_MNetNetworkEnum Lib "WFWNET.DRV" Alias "MNetNetworkEnum" (nIndex As Integer) As Integer
Declare Function WFW_MNetSetNextTarget Lib "WFWNET.DRV" Alias "MNetSetNextTarget" (ByVal nIndex As Integer) As Integer
Declare Function USR_WNetGetUser Lib "User" Alias "WNetGetUser" (ByVal sUser As String, nBufferSize As Integer) As Integer
Declare Function Declare32& Lib "call32.dll" (ByVal func$, ByVal library$, ByVal args$)
Declare Function GetUserNameA Lib "call32.dll" Alias "call32" (ByVal strUser As String, lngUserBuffer As Long, ByVal lngID As Long) As Integer

Private Sub InitializeWin32 ()
'
'   This routine will initialize the Win32 call interface.
'
    If Not mintInitialized Then
    mlngGetUserNameA = Declare32("GetUserNameA", "advapi32.dll", "pp")
    mintInitialized = True
    End If
End Sub

Private Function IsWFW () As Integer
'
'   This routine will determine if Windows for Workgroups is running.
'
    Dim intNetwork As Integer

    IsWFW = False

    intNetwork = USR_WNetGetCaps(WNNC_NET_TYPE)
    If (intNetwork And WNNC_NET_MultiNet) Then
    IsWFW = ((intNetwork And &HFFFF) And WNNC_SUBNET_WinWorkgroups) <> 0
    End If
End Function

Private Function IsWinNT () As Integer
'
'   This routine will determine if the user is running
'   under the Windows NT system.
'
    Dim lngReturnStatus As Long

    IsWinNT = False
    lngReturnStatus = KRN_GetWinFlags()
    If lngReturnStatus And WF_WINNT Then
    IsWinNT = True
    End If
End Function

Function NetworkUserID () As String

'   This routine will get the name of the user signed onto the network.
'   If no username is found it will return an UnknownUser string.
'
    Dim strUser As String
    Dim lngBufferSize As Long
    Dim intHandle As Integer
    Dim intEnumerate As Integer
    Dim intVersion As Integer

    On Error GoTo NetworkUserID_ER
'
'   Initialize the buffer space needed
'
    lngBufferSize = 255
    strUser = Space$(lngBufferSize)
'
'   Get the users current windows version
'
    intVersion = WindowsVersion()
    Select Case intVersion
    Case WV_WIN3X
    mlngReturnStatus = USR_WNetGetUser(strUser, CInt(lngBufferSize))
    If (mlngReturnStatus = WN_SUCCESS) Then
        strUser = Left$(strUser, InStr(strUser, Chr(0)) - 1)
    End If
    Case WV_WINWFW
    intHandle = 0
    intEnumerate = WN_SUCCESS
    intEnumerate = WFW_MNetNetworkEnum(intHandle)
'
'   Scan through the networks until we get a name
'
    While (intEnumerate = WN_SUCCESS)
        mlngReturnStatus = WFW_MNetSetNextTarget(intHandle)
        mlngReturnStatus = USR_WNetGetUser(strUser, CInt(lngBufferSize))
        If (mlngReturnStatus = WN_SUCCESS) Then
        strUser = Left$(strUser, InStr(strUser, Chr(0)) - 1)
        End If
        intEnumerate = WFW_MNetNetworkEnum(intHandle)
    Wend
    Case WV_WINNT, WV_WIN95
'
'   Initialize and call the Win32 API function(s)
'
    If Not mintInitialized Then InitializeWin32
    mlngReturnStatus = GetUserNameA(strUser, lngBufferSize, mlngGetUserNameA)
    If mlngReturnStatus <> 1 Then
        MsgBox "Problem during NetworkUserID, problem code is " & Error
        strUser = "UnknownUser"
        Exit Function
    End If
    strUser = Left$(strUser, InStr(strUser, Chr(0)) - 1)
    Case Else
    strUser = ""
    End Select

    If Len(strUser) = 0 Then
    NetworkUserID = "UnknownUser"
    Else
    NetworkUserID = strUser
    End If
    Exit Function

NetworkUserID_ER:
    MsgBox "Problem during NetworkUserID, problem code is " & Error
    strUser = "UnknownUser"
    Exit Function
End Function

Private Function WindowsVersion () As Integer
'
'   This routine will determine the DOS/Windows version(s).
'   It will return the values back to the calling program.
'
    Dim lngReturnStatus As Long
    Dim strLowByte As String
    Dim strHighByte As String
    Dim sglWindowsVersion As Single
'
'   Check for Windows NT
'
    If IsWinNT() Then
    WindowsVersion = WV_WINNT
    Else
'
'   Since Windows NT is not running, find the version of windows
'
    lngReturnStatus = KRN_GetVersion()
    lngReturnStatus = lngReturnStatus And &HFFFF&
    strLowByte = Trim$(CStr(lngReturnStatus And &HFF))
    strHighByte = Trim$(CStr((lngReturnStatus And &HFF00) / 256))
    sglWindowsVersion = CSng(strLowByte & "." & strHighByte)

    Select Case sglWindowsVersion
    Case Is < 3.95                 ' User is not under Windows 95
'
'   Check to see if the user is running WFW 3.11
'
        If IsWFW() Then
        WindowsVersion = WV_WINWFW
        Else
        WindowsVersion = WV_WIN3X
        End If
    Case Else
        WindowsVersion = WV_WIN95
    End Select
    End If
End Function